
(*
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$$$
$$$   PASCAL FILE NAME .................... M.SAMPLE.TEXT
$$$   PASCAL FILE TYPE .................... TEXT
$$$   PASCAL FILE DATE .................... 1985-MAY-30
$$$
$$$   PASCAL VOLUME NAME .................. MTK
$$$
$$$   DISK IMAGE NAME ..................... A2PASDT2
$$$
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$$$
$$$   DISK IMAGE COMMENT:
$$$
$$$     APPLE II PASCAL DESKTOP TOOLKIT - GRAPHIC MENUS - 1988 - 2/4
$$$
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
*)

{^he 'Mouse Graphics Tool Kit Menus Sample''Page %'}
{^fo '''May 28, 1985'}
{$setc apple:=2}

program psample;
   
   uses
      { This may be different for your system. }
      {$u *tk.rel/ints/m.unit.code}
      mgrkit;
   
   
   const
      
      
      { Menu Constants }
      apple_menu = 1;
      file_menu = 2;
      edit_menu = 3;
      MTest_Menu = 4;
      dummy_menu = 5;
   
   type
      
      charblock= packed array [0..511] of char;
      
   var
      x : integer;
      
      QuitSelected, {Quit the program?}
      use_interrupts{use the mouse in interrupt mode?}
        : boolean;
      
      space
        : char;
        
      tempfile                  { used for loading the font }
        : file;
        
   
      PtrToData
        : ^charblock;
      
      MainPort : grafport;
      
      
      
      ScreenX,
      ScreenY,
      PtrToFont,
      column,
      dragx,
      dragy,
      linenumber,
      menu_choice,
      menu_id,
      MouseSlot,        {obtained by StartDeskTop}
      oldpos
        : integer;
      
      event
        : type_event;
      
        
      {Menubar data structure}
      a_menubar
        : menu_bar;
      
      {Menu data structures}
      MData
        : array [1..max_menus] of menu_data;
      
      {Menubar titles}
      MTitle
        : array [1..max_menus] of title_str;
      
      { Each of these string arrays is set up to use just the
        right amount of space for the menu that use it. }
        
      {Quit menu items title}
      AppleItem
        : array [1..1] of item_str;
        
      {File menu item titles}
      FileItem
        : array [1..1] of item_str;
        
      {Edit menu item titles}
      EditItem
        : array [1..5] of item_str;
        
      {Menu Test item titles }
      MTItem
        : array [1..9] of item_str;
        
      {Dummy Item Titles }
      DummyItem
        : array [1..10] of item_str;
        
      a_string
        : string;
        
      VMajor,VMedium,VMinor,VRelease : integer;
      VStatus : char;


{ Some Utility Procedures }

procedure SoundBell;
    begin { SoundBell }
       write(chr(7));
    end; { of SoundBell }


{ We do this in this way so we can do a readln without
  destroying the pattern data used by the primitives and 
  kept in the text buffers $400-$800.  (0,20) is an
  unused location. }
procedure doreadln;
   begin { doreadln }
      gotoxy(0, 20);
      readln;
   end; { of doreadln }
   



 procedure LoadFont;
    const
       FontSize = 3;    { Num blocks used by the font. }
    var
       NoRead
         : integer;
          
          
          procedure FontMemory;
          { Allocates some memory on the heap for the font.}
          { Is called before the font is loaded. }
          
              var
                 heap
                   : ^integer;
                 memblock
                   : ^charblock;
                 blocknumber
                   : integer;
              begin { FontMemory }
                 mark(heap);
                 moveleft(heap, PtrToFont, 2);
                 for blocknumber:= 1 to FontSize do
                    new(memblock);
              end; { of FontMemory }
    
    begin { LoadFont }
       FontMemory;
       reset(tempfile, 'test.font');
       moveleft(PtrToFont, PtrToData, 2);
       NoRead:= blockread(tempfile, PtrToData^, FontSize, 0);
       close(tempfile);
    end; { of LoadFont }

procedure Initialize;

{ This one procedure initializes all the data structures 
{ used by the tool kit.  If code space is limited this 
{ whole procedure can be segmented and only loaded at
{ the beginning of the run. }

      var
         menu_index,
         title_index
           : integer;
      
      { Sets up the menu identified by Menu_Index.  Sets the MenuID, 
        Disable flag, title pointer, and pointer to menu data. }
      procedure InitTitle (menu_index : integer);
         begin { InitTitle }
            with a_menubar.menus[menu_index] do
               begin
                  menu_id:= menu_index;
                  disabled:= 0;
                  pointer:= PointerTo(MTitle[menuindex]);
                  moveleft(pointer, title_ptr, 2);
                  pointer:= PointerTo(MData[menuindex]);
                  moveleft(pointer, m_data_ptr, 2);
               end; { with }
         end; { of InitTitle }
         
      procedure InitStrings;
         { This procedure puts all the string constants into
         { their respective arrays. }
         
         begin { InitString }
            
            {$R-}
            MTitle[1]:= '?';
            MTitle[1,1] := chr(30); { the apple char in my font.}
            {$R+}
            
               AppleItem[1]:= 'What''s it all about?';
            
            MTitle[file_menu]:= 'File';
               FileItem[1]:= 'Quit';
            
            MTitle[edit_menu]:= 'Edit';
               EditItem[1]:= 'Undo';
               {Item 2 is filler}
               EditItem[3]:= 'Cut';
               EditItem[4]:= 'Copy';
               EditItem[5]:= 'Paste';
               
            MTitle[MTest_Menu] := 'Menu Test';
              MTItem[1] := 'Clear Menu';
              MTItem[2] := 'Disable Menu';
              MTItem[3] := 'Enable Menu';
              MTItem[4] := 'Disable Items';
              MTItem[5] := 'Enable Items';
              MTItem[6] := 'Check Items';
              MTItem[7] := 'Uncheck Items';
              MTItem[8] := 'Change Some Marks';
              MTItem[9] := 'Restore Some Marks';
            
            MTitle[Dummy_Menu] := 'Dummy';
              DummyItem[1] := 'Item 1';
              DummyItem[2] := 'Item 2';
              DummyItem[3] := 'Item 3';
              DummyItem[4] := 'Item 4';
              
              { Filler }
              
              DummyItem[6] := 'Item 6';
              DummyItem[7] := 'Item 7';
              DummyItem[8] := 'Item 8 and more text';
              DummyItem[9] := 'Item 9';
              DummyItem[10] := 'Item 10';
            
         end; { of InitString }
         
      begin { Initialize }
         space:= ' ';
         
         fillchar(a_menubar, sizeof(a_menubar), 0);
         fillchar(MData, sizeof(MData), 0);
         fillchar(MTitle, sizeof(MTitle), 0);
         fillchar(AppleItem, sizeof(AppleItem), 0);
         fillchar(FileItem, sizeof(FileItem), 0);
         fillchar(EditItem, sizeof(EditItem), 0);
         fillchar(MTItem, sizeof(MTItem), 0);
         fillchar(DummyItem, sizeof(DummyItem), 0);
         
         LoadFont;
         
         InitStrings;
         
         with a_menubar do
            begin
               {Set menu titles and data pointers}
               num_menus:= 5;
               for menu_index:= 1 to num_menus do
                  InitTitle (menu_index);
               
               { For each menu we set the item pointers.  For
                 those items that are special, we set them after
                 the pointers are set up.  Note that we rely on
                 the zeroing of the data structures (above) to 
                 intialize the untouched variables. }
               
               {Apple menu}
               with MData[Apple_Menu] do
                  begin
                     num_items:= 1;
                     {point to AppleItem string}
                     pointer:= PointerTo(AppleItem[1]);
                     moveleft(pointer, items[1].item_str_ptr, 2);
                  end; { with }
               
               {File menu}
               with MData[file_menu] do
                  begin
                     num_items:= 1;
                     {point to FileItem strings}
                     for title_index:= 1 to num_items do
                        begin
                           pointer:= PointerTo(FileItem[title_index]);
                           moveleft(pointer, items[title_index].item_str_ptr,
                                    2);
                        end; { for }
                     
                     {line 4 is filler}
                     with items[4] do
                        begin
                           item_is_filler:= true;
                           item_str_ptr:= nil;
                        end; { with }
                  
                     {line 5 has a menu key}
                     with items[5] do
                        begin
                           solid_apple:= true;
                           open_apple:= true;
                           char1:= ord('Q');
                           char2:= ord('q');
                        end; { with }
               
                     
                  end; { with }
                     
               {Edit menu}
               with MData[edit_menu] do
                  begin
                     num_items:= 5;
                     {Point to EditItem strings}
                     for title_index:= 1 to num_items do
                        begin
                           pointer:= PointerTo(EditItem[title_index]);
                           moveleft(pointer, items[title_index].item_str_ptr,
                                    2);
                        end; { for }
                     
                     {line 2 is filler}
                     with items[2] do
                        begin
                           item_is_filler:= true;
                           item_str_ptr:= nil;
                        end; { with }
                  
                     {line 3 has a menu key}
                     with items[3] do
                        begin
                           solid_apple:= true;
                           open_apple:= true;
                           char1:= ord('X');
                           char2:= ord('x');
                        end; { with }
                     
                     {line 4 has a menu key}
                     with items[4] do
                        begin
                           solid_apple:= true;
                           open_apple:= true;
                           char1:= ord('C');
                           char2:= ord('c');
                        end; { with }
                     
                     {line 5 has a menu key}
                     with items[5] do
                        begin
                           solid_apple:= true;
                           open_apple:= true;
                           char1:= ord('V');
                           char2:= ord('v');
                        end; { with }
               
                  end; { with }
               
               {Menu Test Menu}
               with MData[MTest_Menu] do
                  begin
                     num_items:= 9;
                     {point to FileItem strings}
                     for title_index:= 1 to num_items do
                        begin
                           pointer:= PointerTo(MTItem[title_index]);
                           moveleft(pointer, items[title_index].item_str_ptr,
                                    2);
                        end; { for }
                     
                  end; { with }
          
               {Dummy Menu}
               with MData[dummy_menu] do
                  begin
                     num_items:= 10;
                     {point to FileItem strings}
                     for title_index:= 1 to num_items do
                        begin
                           pointer:= PointerTo(DummyItem[title_index]);
                           moveleft(pointer, items[title_index].item_str_ptr,
                                    2);
                        end; { for }
                     
                     {line 5 is filler}
                     with items[5] do
                        begin
                           item_is_filler:= true;
                           item_str_ptr:= nil;
                        end; { with }
                     
                  end; { with }
          
          
          
          end; { with }
                     
                     
      end; { of Initialize }
    
    
    
   { I'm not yet sure what any of this does and what is 
     needed. }
   procedure InitMouseDriver;
      var
          {Mouse driver communications data}
          ErrorCode
            : integer;
          
          MouseMode: record
             IntMode: integer;
             IntAddr: integer;
             end;
             
          RequestCode: packed record
             Direction: 0..1;
             Stat_Ctrl: 0..1;
             Reserved: 0..2047;
             Code: 0..7;
             end;
       
      procedure InitInterrupts;
         begin { InitInterrupts }
            (*
            {Set the attach driver's interrupt address:
             UnitStatus Control code 0.}
            with RequestCode do
               begin
                  Direction:= 0;
                  Stat_Ctrl:= 1;
                  Code:= 0;
               end; { with }
            with MouseMode do
               begin
                  IntMode:= 0; { passive mode for now; if interrupts are
                                 required, StartDeskTop will enable them }
                  PascIntAdr(IntAddr);
               end; { with }
            UnitStatus(131, MouseMode, RequestCode);
            ErrorCode:= IOResult;
            if ErrorCode<> 0 then
               begin
                  WriteLn('SetMouse error: ', ErrorCode);
                  exit(psample);
               end; { if }
            *)
         end; { of InitInterrupts }
     
      begin { InitMouseDriver }
        {Start with the mouse off}
        UnitClear(131);
        ErrorCode:= IOResult;
        if ErrorCode<> 0 then
           begin
              if ErrorCode= 9 then
                 writeln('No mouse card installed.')
              else
                 writeln('UnitClear error: ', ErrorCode);
              exit(psample);
           end; { if }
     
        {InitInterrupts;}
        
     end; { of InitMouseDriver }
     
     
procedure StartItUp;
    begin { StartItUp }
       MouseSlot:= 0;
       use_interrupts:= false;
       pointer:= 4096;
       
       StartDeskTop(6, 234,         {Apple //c, Apple //e}
                    MouseSlot,      {search slots for the mouse}
                    use_interrupts, {passive= false; interrupts= true}
                    PtrToFont,      {pointer to system font}
                    pointer,        {menu save area}
                    4000);          {save area size}
                    
       SetKeyEvent(true);
       
       FlushEvents;
    
       SetMenu(a_menubar);
       ShowCursor;
    end; { of InitDeskTop }
    
      
procedure DoApple;
    begin
    end;

procedure doFile;
    begin { doFile }
      If menu_choice = 1 then
         QuitSelected:= true;
    end; { of doFile }
      
procedure doEdit;
    begin
    end;
   
procedure       DoMenuTest;
    procedure           DisMenu;
        begin
          DisableMenu(Dummy_Menu,true);
        end;
    procedure           EnMenu;
        begin
          DisableMenu(Dummy_Menu,false);
        end;
    procedure           DisItems;
        begin
          DisableItem(Dummy_menu,3,true);
          DisableItem(Dummy_menu,7,true);
          DisableItem(Dummy_menu,8,true);
        end;
    procedure           EnItems;
        begin
          DisableItem(Dummy_menu,3,false);
          DisableItem(Dummy_menu,7,false);
          DisableItem(Dummy_menu,8,false);
        end;
    procedure           CkItems;
        begin
          CheckItem(Dummy_menu,1,true);
          CheckItem(Dummy_menu,3,true);
          CheckItem(Dummy_menu,6,true);
          CheckItem(Dummy_menu,9,true);
          CheckItem(Dummy_menu,10,true);
        end;
    
    procedure           UnckItems;
        begin
          CheckItem(Dummy_menu,1,false);
          CheckItem(Dummy_menu,3,false);
          CheckItem(Dummy_menu,6,false);
          CheckItem(Dummy_menu,9,false);
          CheckItem(Dummy_menu,10,false);
        end;
    
    procedure           ChangeMarks;
        begin
          SetMark(Dummy_menu,3,true,'#');
          SetMark(Dummy_menu,9,true,'*');
        end;
    
    procedure           RestoreMarks;
        begin
          SetMark(Dummy_menu,3,false,' ');
          SetMark(Dummy_menu,9,false,'0');
        end;
        
    procedure           ClearMenu;
        begin
          EnMenu;
          EnItems;
          UnckItems;
          RestoreMarks;
        end;
        
        
    begin
      case menu_choice of
        1: ClearMenu;
        2: DisMenu;
        3: EnMenu;
        4: DisItems;
        5: EnItems;
        6: CkItems;
        7: UnckItems;
        8: ChangeMarks;
        9: RestoreMarks;
      end;
    end;
    
procedure doMenu;
    begin { doMenu }
      if Menu_ID in [applemenu,filemenu,editmenu,mtestmenu,dummymenu] then
        case menu_id of
          apple_menu: doApple;
          file_menu: doFile;
          edit_menu: doEdit;
          MTest_Menu: DoMenuTest;
          dummy_menu : ;
        end
      else exit(DoMenu);
      HiliteMenu(0); 
    end; { of doMenu }

procedure HandleButton;
    begin { HandleButton }
      with event do
        begin
          screenx:= char1+ 256* char2;
          screeny:= char3+ 256* char4;
          if screeny < 10 then
            begin
                MenuSelect(menu_id, menu_choice);
                doMenu;
            end; { case inMenubar }
        end; { with }
    end; { of HandleButton }


begin { psample }
   
   Initialize;
   
   InitMouseDriver;
   StartItUp;
   
   
   QuitSelected:= false;
   Repeat
      GetEvent(event);
      
      if event.evt_kind in [buttondown,keydown] then
        case event.evt_kind of
           button_down : HandleButton;
           key_down : 
             begin
               MenuKey(menu_id, menu_choice, event);
               if menu_id<> 0 then doMenu;
             end;
        end;
   
   Until QuitSelected;
   Version(VMajor,VMedium,VMinor,VStatus,VRelease);
   
   writeln('Version ', VMajor,'.',VMedium,'.',VMinor,VStatus,VRelease,
           '       MemAvail:  ',Memavail);
   
   StopDeskTop;


end. { of psample }


(*
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$$$   END OF FILE : MTK - M.SAMPLE.TEXT
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

File brought to you by:

Apple Macintosh Apple II Pascal Disk Image Dumper 1.0.0 (16 May 2004)
David T Craig (Santa Fe, New Mexico, USA)
shirlgato@cybermesa.com / dcraig@cyberwolf.com

Sunday, June 20, 2004 -- 1:52:06 PM
*)

